home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / ConvertToGray.pdrx < prev    next >
Text File  |  1992-06-15  |  1KB  |  61 lines
  1. /*
  2. @N
  3.  
  4. This Genie will convert the current selection of objects to shades of gray
  5. */
  6. call pdm_AutoUpdate(0)
  7.  
  8. obj = pdm_SelFirstObj()
  9. if obj = 0 then exit_msg("Please select a group of objects first")
  10.  
  11. do while obj ~= 0
  12.  
  13.     lcdata    = pdm_GetColorData(pdm_GetLineColor(obj))
  14.     red        = min(15, word(lcdata, 1) * .3)
  15.     green    = min(15, word(lcdata, 2) * .59)
  16.     blue    = min(15, word(lcdata, 3) * .11)
  17.     lcdata    = red + green + blue
  18.     call pdm_SetLineColor(obj, "UNNAMED RGB "lcdata" "lcdata" "lcdata)
  19.  
  20.     fill = pdm_GetFillPattern(obj)
  21.     parse var fill type '0a'x color1 '0a'x color2 '0a'x a '0a'x b '0a'x c '0a'x d 
  22.  
  23.     if type ~= 0 then
  24.     do
  25.  
  26.         color1    = pdm_GetColorData(color1)
  27.         red        = min(15, word(color1, 1) * .3)
  28.         green    = min(15, word(color1, 2) * .59)
  29.         blue    = min(15, word(color1, 3) * .11)
  30.         grey    = red + green + blue
  31.         color1    = "UNNAMED RGB "grey" "grey" "grey
  32.  
  33.         if type > 1 then
  34.         do
  35.             color2 = pdm_GetColorData(color2)
  36.             red        = min(15, word(color2, 1) * .3)
  37.             green    = min(15, word(color2, 2) * .59)
  38.             blue    = min(15, word(color2, 3) * .11)
  39.             grey    = red + green + blue
  40.             color2    = "UNNAMED RGB "grey" "grey" "grey
  41.         end
  42.  
  43.         call pdm_SetFillPattern(obj, type, color1, color2, a, b, c, d)
  44.     end
  45.  
  46.     obj = pdm_SelNextObj(obj)
  47.  
  48. end
  49.  
  50. exit_msg()
  51.  
  52. exit_msg: procedure
  53. do
  54.     parse arg message
  55.  
  56.     if message ~= 0 then call pdm_Inform(1,message,)
  57.     call pdm_AutoUpdate(1)
  58.     exit
  59. end
  60.  
  61.